COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	
C00004 00003	
C00009 00004	SUBR COMND
C00013 ENDMK
C⊗;

BEGIN "SYN4D"
	REQUIRE "GEOMES.HDR[GEM,HE]" SOURCE_FILE;
	DEFINE α="COMMENT";
	DEFINE π="3.1415927";
	DEFINE SUBR="SIMPLE PROCEDURE";
	DEFINE ISUBR="SIMPLE INTEGER PROCEDURE";
	DEFINE THRU="STEP 1 UNTIL";
	DEFINE ⊂="BEGIN";
	DEFINE ⊃="END";

	EXTERNAL SIMPLE REAL PROCEDURE ACOS(REAL W);

	INTEGER FRATE,CHR,GRAV,TAKE,IP,X,Y,Z;
	REAL NR,NT;STRING STR;

SUBR INIT;	α INITIALIZATION;
BEGIN "INIT"
	MKUNIV;GEODPY;
	X ← 0;Y ← 3;Z ← 6;
	IP ← 0;TAKE ← 1;
	FRATE ← 20;
	OUTSTR("   FRATE =");STR ← INCHWL;
	IF LENGTH(STR)≠0 THEN FRATE ← INTSCAN(STR,CHR);
	NT ← 1.0/FRATE;NR ← NT*π;GRAV ← 32*NT;
END "INIT";


SIMPLE REAL PROCEDURE ANGL(INTEGER B1,A1,B2,A2);
BEGIN "ANGL"
	REAL ANG;
	B1 ← A1+LOCOR(B1);
	B2 ← A2+LOCOR(B2);
	ANG ← ACOS(IX(B1)*IX(B2)+IX(B1+1)*
	IX(B2+1)+IX(B1+2)*IX(B2+2));
	RETURN(ANG);
END "ANGL";

ISUBR BUMP(INTEGER B1,B2,AX1,AX2;REAL MINA,MAXA,SP);
BEGIN "BUMP"
	INTEGER STP;
	REAL ANG;
	IF B1<0 THEN B1 ← -B1;
	IF B2<0 THEN B2 ← -B2;
	ANG ← SP+ANGL(B1,AX1,B2,AX2);
	IF ANG<0 THEN ANG ← -ANG;
	IF ANG<MINA∨ANG>MAXA THEN STP ← -1
	ELSE STP ← 0;
	RETURN(STP);
END "BUMP";

ISUBR BEND(INTEGER BAC,BD1,BD2,AR1,AR2,AR3;REAL MN,MX,SP);
BEGIN "BEND"
	INTEGER PAST;
	REAL RO,RX,RY,RZ;
	RO ← NR*SP;
	IF BUMP(BD1,BD2,AR2,AR3,MN,MX,RO) THEN BEGIN
	  PAST ← -1;
	  IF BAC THEN BEGIN
	    IF BAC>0 THEN RETURN(PAST);
	    RO ← -RO;
	    END;
	  END
	ELSE PAST ← 0;
	RX ← RY ← RZ ← 0;
	CASE AR1 OF ⊂ [0] RX ← RO;[3] RY ← RO;[6] RZ ← RO ⊃;
	ROTATE(BD1,RX,RY,RZ);
	RETURN(PAST);
END "BEND";

SIMPLE REAL PROCEDURE ANGLE(INTEGER B1,A1,N1);
BEGIN "ANGLE"
	INTEGER O1;
	REAL DIS,AN;
	O1 ← LOCOR(B1);DIS ← DISTAN(N1,O1);O1 ← O1+A1;
	AN ← ACOS(IX(O1)*((XWC(B1)-XWC(N1))/DIS)+IX(O1+1)*
	((YWC(B1)-YWC(N1))/DIS)+IX(O1+2)*((ZWC(B1)-ZWC(N1))/DIS));
	RETURN(AN);
END "ANGLE";

SIMPLE REAL PROCEDURE RBDEL(INTEGER B1,A1,B2,A2;REAL DV);
BEGIN "RBDEL"
	REAL RB;
	RB ← ANGL(B1,A1,B2,A2)/DV;
	RETURN(RB);
END "RBDEL";

SIMPLE REAL PROCEDURE RODEL(INTEGER B1,A1,N1;REAL DV);
BEGIN "RODEL"
	REAL ROD;
	ROD ← ANGLE(B1,A1,N1)/DV;
	RETURN(ROD);
END "RODEL";

SIMPLE REAL PROCEDURE TDEL(INTEGER B1,N1;REAL DV);
BEGIN "TDEL"
	REAL TD;
	TD ← DISTAN(N1,LOCOR(B1))/DV;
	RETURN(TD);
END "TDEL";

α SIMPLE REAL PROCEDURE VOLUME(INTEGER B1);
α BEGIN "VOLUME";
α 	  EXTERNAL SIMPLE REAL PROCEDURE DETERM(INTEGER Q);
α 	  INTEGER F,V1,V2,V3,E,E0,I,Q;
α	  REAL VOL;
α	  Q ← MKNODE(0)  F ← PFACE(B1)  VOL ← 0;
α	  DO BEGIN;
α	    I ← 0  E0 ← PED(F)  E ← ECCW(E0,F);
α	    V1 ← VCW(E0,F)  V2 ← VCCW(E0,F)  V3 ← VCCW(E,F);
α	    IX(Q) ← XWC(V1)  IY(Q) ← YWC(V1)  IZ ← ZWC(V1);
α	    JX(Q) ← XWC(V2)  JY(Q) ← YWC(V2)  JZ ← ZWC(V2);
α	    KX(Q) ← XWC(V3)  KY(Q) ← YWC(V3)  KZ ← ZWC(V3);
α	    VOL ← VOL + DETERM(Q);
α	  END UNTIL B1=(F←PFACE(F))  RETURN(VOL);
α END "VOLUME";

SUBR PLOP;
BEGIN "PLOP"
   α IF CA THEN CAMR()????;
	IF TAKE>0 THEN ⊂ IF TAKE>1 THEN SHOW2(0,1)
		       ELSE GEODPY;RETURN;⊃;
	IF TAKE<-1 THEN SHOW2(0,1) ELSE GEODPY;
	IP ← IP+1;
	OUTSTR(" FRAME "&CVS(IP));PLOTO("FRM."&CVS(IP));
END "PLOP";
SUBR COMND;
BEGIN "COMND"
	INTEGER PIC,GIRL,HD,RA,LA,RS,LS,RH,LH;
	INTEGER RT,LT,RL,LL,RF,LF;
	INTEGER YES,NO,ONE,LC;
	REAL DG4,DG5,DG7,DG11,FAST,SLOW,FASTER;

α INIT THEN DO UNTIL?;

 SUBR NOD(INTEGER UPDOW;REAL SP);
 BEGIN "NOD"
	INTEGER A1,A2,A3;
	REAL MI,MA;
	IF UPDOW THEN ⊂ A1 ← X;A2 ← Z;A3 ← Y;
	  MI ← DG7;MA ← DG11;⊃
	ELSE ⊂ A1 ← Y;A2 ← X;A3 ← Z;MI ← DG4;MA ← DG5;⊃;
	WHILE TRUE DO
	⊂ IF BEND(YES,-HD,GIRL,A1,A2,A3,MI,MA,SP) THEN SP ← -SP;
	  PLOP;LC ← INCHRS;IF LC≥0 THEN RETURN;⊃;
 END "NOD";

SUBR SALUTE(REAL SP);
BEGIN "SALUTE"
	INTEGER I;
	REAL MI,MX,MA,MB,MC,MD;
	MA ← 0;MI ← π/2;MB ← π/1.2;MX ← π/8;I ← 3;
	MC ← π/4;MD ← π/2;
	WHILE TRUE DO
	⊂ I ← I+BEND(ONE,-RA,RS,X,Y,Y,MA,MB,-SP);
	  I ← I+BEND(ONE,-RS,GIRL,Z,Y,X,MC,MD,-SP);
	  I ← I+BEND(ONE,-RS,GIRL,X,Z,Y,MX,MI,-SP);
	  IF I=0 THEN ⊂ IF SP<0 THEN RETURN;SP ← -SP;⊃;
	  I ← 3;PLOP;⊃;
END "SALUTE";

	PIC←INB3D("SKY[CMS,LCS]");
	GIRL←FDNAME("GIRL");
	HD←FDNAME("HD");
	RA←FDNAME("RA");
	LA←FDNAME("LA");
	RL←FDNAME("RL");
	LL←FDNAME("LL");
	RF←FDNAME("RF");
	LF←FDNAME("LF");
	RS←FDNAME("RS");
	LS←FDNAME("LS");
	RT←FDNAME("RT");
	LT←FDNAME("LT");
	RH←FDNAME("RH");
	LH←FDNAME("LH");
	GEODPY;

	NO ← 0;YES ← -1;FAST ← .5;SLOW ← .3;ONE ← 1;
	FASTER ← .8;

α SIMPLER ROTE AS NR*ANGSP;
	DG4 ← π/4;DG5 ← DG4*3;
	DG7 ← π/2.5;DG11 ← π/1.8;

WHILE TRUE DO
 BEGIN "FIGER"
	LC ← INCHRW;
	IF LC="N" THEN NOD(NO,FAST);
	IF LC="Y" THEN NOD(YES,SLOW);
	IF LC="A" THEN SALUTE(FASTER);
	IF LC="S" THEN SALUTE(FAST);
	IF LC="G" THEN GEOMED;
	IF LC="P" THEN ⊂ TAKE ← -TAKE;PLOP;⊃;
 END "FIGER";

END "COMND";



        α MAIN EXECUTION;
	OUTSTR(12&12&12&12&12);
	INIT;
	COMND;

END "SYN4D";